unit kgs_searcher;

interface

uses classes,sysutils,contnrs,kgs_postings,kgs_tokenizer,
kgs_classes,intlist,dateutils;

const
  maxphrasetoken = 16;
  maxphrase = 6;
  MAXOFFSET = $FFFFFFFFFF ; // 40 bits
  
type

  //simple phrase
  TMatchMode = (mmExact=0, mmBegin=1, mmMiddle=3, mmEnd=2, mmRegex=3);
  TPhrase = class(TPersistent)
    private
    fupper ,flower:int64;
    ftofind:widestring;
    ftokenizer:TTokenizer;
    selftokenizer:boolean;
    tokenpostings:TObjectStack;
    ftablename:widestring;


    working:TObjectStack;
    floopcount:integer;
//    finverted:TKNInvertedLoader;
    fdb:TKGSDatabase;
    phraselen:integer;
    phrasetokencount:integer;
    temporary:boolean; //temporaray phrase created by merging
    haswildcard:boolean;
    tokenizer:TTokenizer;
    public
    elapsetime:int64;


    procedure cleartokenpostings;
    procedure mergetoken;

    public
    match:TVintList;

    constructor create(db:TKGSDatabase;tb:widestring;tknr:TTOkenizer);virtual;
    procedure run(thephrase:widestring);
    procedure fieldmatch(ot,ct:TVintlist;matchmode:TMatchMode;var fieldmatch:Tintlist);
//    procedure groupby(group:TKNAbilityLoader;var gmatch:TIntList; maxcount:integer=9999);overload;
    procedure groupby(group:TVintlist;var gmatch:TIntList; maxcount:integer=9999);overload;
    destructor destroy;override;
    property loopcount:integer read floopcount;
    //property match : TVintlist read match;
    function activated:boolean;
    procedure clear;
    function LoadToken(Token:widestring):TVIntList;

    function tokencount:integer;
    function andtoken(const p1,p2:TVintlist;distance:integer=1):TVintlist;

    property tofind :widestring read ftofind;
    procedure setbound(upper,lower:int64);
    property upper:int64 read fupper;
    property lower:int64 read flower;

  end;

  TKGSSearcher = class(TPhrase)
    public
     tokenizer:TTokenizer;
     constructor create(db:TKGSDatabase;tb:widestring;tknr:string='TTokenizer');
  end;

implementation
var
 _loopcount:integer;

{ TPhrase }

{*------------------------------------------------------------------------------
  take two posting p1,p2, create a new postlist for all
  p1.value+1=p2.value

  @return ResultDescription
------------------------------------------------------------------------------*}

function TPhrase.LoadToken(Token:widestring):TVIntList;
var
  inverted,ms_offset,ms_count:TMemoryStream;
begin
  inverted:=TMemoryStream.create;
  ms_offset:=TMemoryStream.create;
  ms_count:=TMemoryStream.create;

  fdb.findtoken(token, inverted, ms_offset, ms_count);
  result:=TVintList.create;
  result.readfromstream(inverted,ms_offset,ms_count);

  inverted.free;
  ms_offset.free;
  ms_count.free;
end;


function TPhrase.andToken(const p1,p2:TVintlist;distance:integer=1):TVintlist;
begin
  result:=TVintlist.create;
  p1.justbigger(fupper);
  p2.justbigger(p1.curvalue );

  if distance>0 then begin

  repeat // fix distance  A[distance]B

    inc(_loopcount);
    if p2.curcount=p2.count then break;
    
    p2.justbigger(p1.curvalue);
    if p1.curvalue+distance=p2.curvalue then begin
      result.add(p1.curvalue)   ;
      p1.next;
    end else begin
      p1.justbigger(p2.curvalue-1-distance); //justsmaller
      if p1.curvalue+distance=p2.curvalue then begin
        result.add(p1.curvalue);
      end;
      //checking is important

      while p1.curvalue<p2.curvalue do begin
         p1.next;
         if p1.atend then break;
      end;

    end;

  until (p1.atend) or (p2.atend) or (p1.curvalue>flower) or (p2.curvalue>flower);

  end else begin

  repeat
    distance:=-distance;
    inc(_loopcount);
    p2.justbigger(p1.curvalue);
    if (p1.curvalue>p2.curvalue) and (p1.curvalue+distance<=p2.curvalue) then begin
      result.add(p1.curvalue);
      p1.next;
    end else begin
      p1.justbigger(p2.curvalue-1-distance-1); //justsmaller
      if (p2.curvalue>p1.curvalue) and (distance>=p2.curvalue-p1.curvalue) then begin
        result.add(p1.curvalue);
      end;
      //checking is important
      if p1.curvalue<p2.curvalue then p1.next;
    end;
  until (p1.atend) or (p2.atend) or (p1.curvalue>flower) or (p2.curvalue>flower);

  end;

end;

constructor TPhrase.create(db:TKGSDatabase;tb:widestring;tknr:TTokenizer);
begin
  ftablename:=tb;
  ftokenizer:=tknr;


  working:=TObjectstack.create;
  tokenpostings:=TObjectstack.create;
  fdb:=db;
  ftablename:=tb;

  fupper:=0;
  flower:=MAXOFFSET;
end;

{*------------------------------------------------------------------------------
  pop 2 postings from stack , merge and push it back.
  until stack only have one item.

  if stack has only one token, merging is not required.

  working stack will be empty after this call

  @return ResultDescription
------------------------------------------------------------------------------*}
procedure TPhrase.mergetoken;
var
  p,p1,p2:TVintlist;
  distance:integer;
begin
  _loopcount:=0;
  while working.Count>1 do begin
    p1:=TVintlist(working.pop);
    p2:=TVintlist(working.pop);

    distance:=0;
    if p2.wildcard<>0 then begin
      inc(distance,p2.wildcard);

      if (working.count>0) then begin
        p2:=TVintlist(working.pop);
      end else begin
        working.push(p1); //use p1 as result
        break;
      end;

    end;

    p:=andtoken(p2,p1,distance+1);
    working.push(p);
    //wildcard is added as if loaded from disk
    //clearpostlist will free the wildcard

    if not p1.fromdisk and (p1.wildcard=0) then p1.free;  // free postlist of middle stage
    if not p2.fromdisk and (p2.wildcard=0) then p2.free;
  end;
  if working.count>0 then match:=TVintlist(working.pop);
  floopcount:=_loopcount;
end;

procedure TPhrase.cleartokenpostings;
var
  pl:TVintlist;
  i:integer;
begin
  if not assigned(tokenpostings) then exit;
  for i:=0 to tokenpostings.Count-1 do begin
    pl:=TVintlist(tokenpostings.pop);
    pl.free;
  end;
end;


{*------------------------------------------------------------------------------
  tokenizer the input phrase, 'tokenpostings' hold all loaded token postings
  working is same as tokenpostings before merging.

  @return ResultDescription
------------------------------------------------------------------------------*}
procedure TPhrase.run(thephrase:widestring);

  function createwildcard(len:integer=1):TVintlist;
  begin
    result:=TVintlist.create;
    haswildcard:=true;
    result.wildcard:=len;
  end;
  function checkwildcard(token:TToken):TVintlist;
  var
    p:integer;
  begin
    result:=nil;
    if token.len<>1 then exit;
    if token.text[0]='?' then begin
      result:=createwildcard;
    end else if token.text[0]='*' then begin
      result:=createwildcard(-8);
    end;

  end;

var
  previous,pl:TVintlist;
  p:integer;
  t:TDateTime;

begin
  t:=time;

  haswildcard:=false;
  clear;
  previous:=nil;
  phraselen:=0;
  phrasetokencount:=0;
  ftofind:=thephrase;

  ftokenizer.setup(pwidechar(thephrase));

  while ftokenizer.next do begin
   // ftokenizer.FormatToken ;

    pl:=checkwildcard(ftokenizer.token);

    //drop leading wildcard
    if ftokenizer.token.tokentype=ttSpace then continue;
    if assigned(pl) and (pl.wildcard<>0) and (tokenpostings.count=0) then continue;

    // ??? ==> ?(3)
    if assigned(pl) and assigned(previous) and (previous.wildcard<>0) then begin
      inc(previous.wildcard,pl.wildcard);
      pl.Free;
      continue; //merge multiple wildcard
    end;

    // check if token exist
    //if pl=nil then pl:=finverted.loadtoken(ftokenizer.token.text);
    if pl=nil then pl:=loadtoken(ftokenizer.rawToken[0]);

    //stopwords are considered as wildcard
    {
    if (pl=nil) and assigned(finverted.stopwords) and
      finverted.stopwords.find(ftokenizer.token.text,p,ftokenizer.token.len) then
      pl:=createwildcard;
    }
    
    //symbol and non literal token might be filtered out, consider as wildcard
    if (pl=nil) and ((ftokenizer.token.tokentype<ttLiteral)
      or (ftokenizer.token.tokentype=ttSymbol)) then pl:=createwildcard;

    //panic ,cannot load token
    if pl=nil then begin
      cleartokenpostings;
      if match=nil then match:=TVintlist.create;
      exit;
    end;

    inc(phraselen);//,ftokenizer.token.len);
    inc(phrasetokencount);

    previous:=pl;

    tokenpostings.Push(pl);
    working.Push(pl);

  end;

  //drop ending wildcard
  while working.count>0 do begin
    pl:=TVintlist(working.peek);
    if pl.wildcard<>0 then begin

      if pl.wildcard>0 then dec(phraselen,pl.wildcard);
      pl.free;
      working.pop;
      tokenpostings.pop;
    end else break;
  end;

  MergeToken;
  if match=nil then match:=TVintlist.create;

  elapsetime:=millisecondsbetween(time,t);
  
end;

destructor TPhrase.destroy;
begin
  clear;
  freeandnil(working);
  if selftokenizer then freeandnil(ftokenizer);

  freeandnil(tokenpostings);
  tokenpostings:=nil;

  inherited;
end;

function TPhrase.tokencount: integer;
var
  lastpl:TVintlist;
begin
  if haswildcard then begin
    lastpl:=TVintlist(tokenpostings.Peek);
    lastpl.justbigger(match.curvalue);
    result:=lastpl.curvalue-match.curvalue+1;
  end else begin
    result:=tokenpostings.Count;
  end;
end;


function TPhrase.activated: boolean;
begin
  result:=assigned(match);
end;

procedure TPhrase.clear;
begin
  if assigned(match) and (not match.fromdisk) then begin
    freeandnil(match);
  end;
  cleartokenpostings;
  match:=nil;
  phraselen:=0;
end;

procedure TPhrase.fieldmatch(ot,ct:TVintlist ; matchmode: TMatchMode;
  var fieldmatch: Tintlist);
begin
  fieldmatch.clear;

  if (match=nil) or (match.count=0) then exit;

  match.first;
  ot.first ;
  ct.first;

  if matchmode=mmend then begin
    repeat
      ct.justbigger(match.curvalue-1);
      if match.curvalue+phrasetokencount-1 =ct.curvalue then begin
        //fieldmatch.add(ct.curcount-1);
        fieldmatch.addobject(match.curvalue,tobject(ct.curcount-1));
        ct.next;
      end;
      match.justbigger(ct.curvalue);
    until (match.atend) or (ct.atend);
  end else if matchmode=mmbegin then begin
    repeat
      ct.justbigger(match.curvalue-1);
      ot[ct.curcount-1];

      if (match.curvalue=ot.curvalue+1) and (match.curvalue<ct.curvalue) then begin
        fieldmatch.addobject(match.curvalue,tobject(ct.curcount-1));
//        fieldmatch.add(ct.curcount-1);
//        ct.next;
      end;
      match.justbigger(ct.curvalue);
    until (match.atend) or (ct.atend);
  end else  if matchmode=mmmiddle then begin

    repeat
      ct.justbigger(match.curvalue-1);
      ot[ct.curcount-1];

      if (match.curvalue >= ot.curvalue+1) and (match.curvalue+phraselen<=ct.curvalue) then begin
        fieldmatch.addobject(match.curvalue,tobject(ct.curcount-1));
        ct.next;
      end;
      match.justbigger(ct.curvalue);
    until (match.atend) or (ct.atend);

  end else if matchmode=mmExact then begin
    repeat
      ct.justbigger(match.curvalue-1);
      ot[ct.curcount-1];

      if (match.curvalue = ot.curvalue+1) and (match.curvalue=ct.curvalue) then begin
        fieldmatch.addobject(match.curvalue,tobject(ct.curcount-1));
        ct.next;
      end;
      match.justbigger(ct.curvalue);
    until (match.atend) or (ct.atend);

  end;


 // match.CustomSort( sortbycount );


end;
function sortbycount(List: TIntList; Index1, Index2: Integer): Integer;
begin
  result:=  integer(list.Objects[index2])-integer(list.Objects[index1])
end;

procedure TPhrase.groupby(group: TVintlist; var gmatch: TIntList;
  maxcount: integer);
var
  c,i:integer;
  lastv:int64;
begin
  gmatch.clear;
  if (match=nil) or (match.count=0) then exit;
  match.first;

  lastv:=0;
  group.first;

  repeat  //see if between plgroup
    c:=match.curcount;
    group.justbigger(match.curvalue);
    if match.curcount=match.count then break;
    match.justbigger( group.curvalue );
    if (match.curcount-c) > 0 then begin
      gmatch.addobject(group.curcount-1,TObject(match.curcount-c));
      group.next;
      if gmatch.count>=maxcount then break;
    end;


  until (match.atend) or (group.atend);

  gmatch.CustomSort( sortbycount );
end;

procedure TPhrase.setbound(upper, lower: int64);
begin
  fupper:=upper;
  flower:=lower;
end;

constructor TKGSSearcher.create(db:TKGSDatabase;tb:widestring;tknr:string='TTokenizer');
var
  tokenizerclass:TTokenizerClass;
begin
  db.select(tb);
  tokenizerclass:=TTokenizerClass(FindClass(tknr));
  if not assigned(tokenizerclass) then begin
    raise exception.create('error finding class '+tknr);
  end;
  tokenizer:=Tokenizerclass.create;
  inherited create(db,tb,tokenizer);
end;

end.
